perm filename DSKFUN.F4[1,MUS] blob sn#081801 filedate 1974-01-15 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE DSKFUN
C00004 00003		SUBROUTINE DSKWRT
C00005 ENDMK
CāŠ—;
	SUBROUTINE DSKFUN
	COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
	COMMON FREQ1(3,0/50,100)
	TYPE 2
2	FORMAT('+TYPE FILE NAME FOR INPUT SPECTRUM'/)
3	ACCEPT 6,FILE
6	FORMAT(A5)
	IF(LOOKD(FILE).GE.0)GO TO 2
	CALL IFILE(1,FILE)
 	READ(1,4),(((FREQ1(J,K,L),J=1,3),K=0,50),L=1,100)
C	READ(1,4)FREQ1
4	FORMAT(15300F)
	TYPE 8
8	FORMAT('+TYPE SCALE FACTOR FOR AMP OF INPUT SPECTRUM OR CR'/)
	ACCEPT 24,SCALE
	IF(SCALE.EQ.0.0)SCALE=1.0
	TYPE 10
10	FORMAT('+TYPE 1 TO ADD DSK SPECT. TO CORE SPECT OR CR'/)
	ACCEPT 24,TEST
24	FORMAT(F)
	IF(TEST.NE.0.0)GO TO 12
	DO 7 J=1,3
	DO 7 K=0,50
	DO 7 L=1,100
7	FREQ(J,K,L)=FREQ1(J,K,L)
	RETURN
12	XMAX=0.0
	DO 31 L=1,100
	DO 32 K=0,49
	DO 33 J=0,49
	IF(FREQ1(1,K,L).EQ.99999.)GO TO 32
	IF(ABS(FREQ1(1,K,L)).NE.ABS(FREQ(1,J,L)))GO TO 20
	FREQ(2,J,L)=FREQ(2,J,L)+(FREQ1(2,K,L)*SCALE)
	GO TO 32
C	IF(FREQ(2,J,L).GT.XMAX)XMAX=FREQ(2,J,L)
20	IF(FREQ(1,J,L).NE.99999.)GO TO 33
	DO 40 N=1,3
40	FREQ(N,J,L)=FREQ1(N,K,L)
	FREQ(1,50,1)=FREQ(1,50,1)+1.0
	GO TO 32
33	CONTINUE
32	CONTINUE
31	CONTINUE
	RETURN
	END
	SUBROUTINE DSKWRT
	COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
	COMMON FREQ1(3,0/50,100)
	TYPE 1
1	FORMAT('+TYPE FILE NAME FOR DSK STORAGE OF SPECTRUM'/)
	ACCEPT 3,FILE
3	FORMAT(A5)
	CALL OFILE(1,FILE)
 	WRITE(1,5),(((FREQ(J,K,L),J=1,3),K=0,50),L=1,100)
C	WRITE(1,5)FREQ1
5	FORMAT(15300F)
	END FILE 1
	TYPE 7,FILE
7	FORMAT('+ALL DONE WRITING FILE ',A5/)
	RETURN
	END